﻿Imports System.Drawing
Imports System.Xml
Imports System.Windows.Forms
Public Class Game
    ' Key Detection
    Dim KeyPushed As Short = 0
    Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Integer) As Short
    Public Function GetKeyState(ByVal key1 As Integer) As Boolean
        Dim s As Short
        s = GetAsyncKeyState(key1)
        If s = 0 Then Return False

        Return True
    End Function

    ' VIEW PORT
    Dim ResWidth As Integer = 750
    Dim ResHeight As Integer = 550
    Dim TileSize As Integer = 32

    ' GRAPHICS VARIABLES
    Dim G As Graphics
    Dim BBG As Graphics
    Dim BB As Bitmap
    Dim bmpTile As Bitmap
    Dim sRect As Rectangle
    Dim dRect As Rectangle

    ' FPS COUNTER
    Dim tSec As Integer = TimeOfDay.Second
    Dim tTicks As Integer = 0
    Dim MaxTicks As Integer = 0

    ' MAP VARIABLES
    Dim MapHeight As Integer = 100
    Dim MapWidth As Integer = 100

    Dim Map(MapHeight, MapWidth, 10) As Integer
    Dim MapX As Integer = 20
    Dim MapY As Integer = 20

    ' GAME RUNNING ?
    Dim IsRunning As Boolean = True

    ' MOUSE LOCATIONS
    Dim mouseX As Integer
    Dim mouseY As Integer
    Dim mMapX As Integer
    Dim mMapY As Integer

    ' TOON VARIABLES
    Dim bmpToon As Bitmap
    Dim xPos As Integer = 0
    Dim yPos As Integer = 0
    Dim MoveSpeed As Integer = 6
    Dim MoveDir As Short = 0
    Dim aniFrame As Short = 0
    Dim LastDir As Short = 2

    Dim GuyX As Decimal = (MapX + 9) * TileSize
    Dim GuyY As Decimal = (MapY + 6) * TileSize

    ' PAINT BRUSH
    Dim PaintBrush As Integer = 0

    ' SHOW DIALOG
    Dim OpenDialog As Boolean = False

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Show()
        Me.Focus()

        ' INITIALIZE GRAPHICS OBJECTS
        G = Me.CreateGraphics
        BB = New Bitmap(ResWidth, ResHeight)
        bmpTile = New Bitmap(GFX.pbGFX.Image)
        bmpToon = New Bitmap(GFX.pbToon.Image)

        LoadMap("spawnmap")

        'AxWindowsMediaPlayer1.URL = My.Application.Info.DirectoryPath.ToString & "\noticeme.mp3"
        'AxWindowsMediaPlayer1.settings.volume = My.Settings.Volume
        'AxWindowsMediaPlayer1.Ctlcontrols.play()

        'Dim characterNameString As String = Login.UsernameTextBox.Text

        'GetInfo()

        'playerNameLabel.Text = characterNameString.ToString

        StartGameLoop()
        animationTimer.Start()
    End Sub
    Private Sub StartGameLoop()
        Do While IsRunning = True
            ' KEEP APP RESPONSIVE
            Application.DoEvents()

            '1.) Check user input
            SetMoveDir()
            MoveToon(MoveDir)
            If MapX = 25 And MapY = 19 Then
                LoadMap("livingroom")
            End If
            '2.) Run AI
            '3.) Update Object Data (Object Positions, Status, etc.)
            '4.) Check Triggers and Conditions
            '5.) Draw Graphics
            DrawGraphics()
            '6.) Playing Sound Effects & Music

            ' UPDATE TICK COUNTER
            TickCounter()
            System.GC.Collect()
        Loop
    End Sub
    Private Sub SetMoveDir()
        If Me.Focused = True Then
            If GetKeyState(Keys.W) = True Then MoveDir = 1
            If GetKeyState(Keys.S) = True Then MoveDir = 2
            If GetKeyState(Keys.A) = True Then MoveDir = 3
            If GetKeyState(Keys.D) = True Then MoveDir = 4
            If GetKeyState(Keys.Escape) = True Then Settings.Show()

            If GetKeyState(Keys.T) = True Then OpenDialog = True
            If GetKeyState(Keys.T) = False Then OpenDialog = False

            If GetKeyState(Keys.W) = False And _
                GetKeyState(Keys.S) = False And _
                GetKeyState(Keys.A) = False And _
                GetKeyState(Keys.D) = False _
            Then
                MoveDir = 0
            End If

            If MoveDir <> 0 Then LastDir = MoveDir
        End If
    End Sub

    Private Sub MoveToon(ByVal dir As Short)
        Select Case dir
            Case 1
                If IsBlocked(0) = False Then
                    yPos += MoveSpeed
                    GuyY = (GuyY - MoveSpeed)

                    If yPos >= TileSize Then
                        yPos = 0
                        MapY -= 1
                    End If
                End If
            Case 2
                If IsBlocked(1) = False Then
                    yPos -= MoveSpeed
                    GuyY = (GuyY + MoveSpeed)

                    If yPos <= TileSize * -1 Then
                        yPos = 0
                        MapY += 1
                    End If
                End If
            Case 3
                If IsBlocked(2) = False Then
                    xPos += MoveSpeed
                    GuyX = (GuyX - MoveSpeed)

                    If xPos >= TileSize Then
                        xPos = 0
                        MapX -= 1
                    End If
                End If
            Case 4
                If IsBlocked(3) = False Then
                    xPos -= MoveSpeed
                    GuyX = (GuyX + MoveSpeed)

                    If xPos <= TileSize * -1 Then
                        xPos = 0
                        MapX += 1
                    End If
                End If
        End Select
    End Sub

    Private Sub DrawGraphics()
        'FILL THE BACKBUFFER
        'DRAW TILES
        bmpTile.MakeTransparent(Color.Fuchsia)
        For X = -1 To 19
            For Y = -1 To 14
                GetSourceRect(MapX + X, MapY + Y, TileSize, TileSize)

                dRect = New Rectangle((X * TileSize) + xPos, (Y * TileSize) + yPos, TileSize, TileSize)
                G.DrawImage(bmpTile, dRect, sRect, GraphicsUnit.Pixel)
            Next
        Next

        ' DRAW FINAL LAYERS
        'GUYS, MENUS, ETC.
        ' CLEANUP EDGE
        G.FillRectangle(Brushes.Wheat, 610, 0, 200, 500)

        G.FillRectangle(Brushes.Red, 21 * TileSize, 4 * TileSize, TileSize, TileSize)
        G.FillRectangle(Brushes.Blue, 21 * TileSize, 6 * TileSize, TileSize, TileSize)

        ' DRAW TOON
        GetToon(LastDir)
        bmpToon.MakeTransparent(Color.Fuchsia)
        G.DrawImage(bmpToon, 9 * TileSize, 6 * TileSize, sRect, GraphicsUnit.Pixel)

        ' DRAW DIALOG
        If OpenDialog = True Then
            DrawDialogBox("lol")
        End If

        'DrawInventory()

        ' DRAW MOUSE BOX
        G.DrawRectangle(Pens.Red, mouseX * TileSize, mouseY * TileSize, TileSize, TileSize)

        G.DrawString("Ticks: " & tTicks & vbCrLf & _
                     "TPS: " & MaxTicks & vbCrLf & _
                     "Mouse X: " & mouseX & vbCrLf & _
                     "Mouse Y: " & mouseY & vbCrLf & _
                     "M MapX: " & mMapX & vbCrLf & _
                     "M MapY: " & mMapY & vbCrLf & _
                     "MapX: " & MapX & vbCrLf & _
                     "MapY: " & MapY & vbCrLf & _
                     "Key Pushed: " & KeyPushed & vbCrLf & _
                     "", Me.Font, Brushes.Black, 650, 0)

        ' COPY BACKBUFFER TO GRAPHICS OBJECT
        G = Graphics.FromImage(BB)

        ' DRAW BACKBUFFER TO SCREEN
        BBG = Me.CreateGraphics
        BBG.DrawImage(BB, 0, 0, ResWidth, ResHeight)

        ' FIX OVERDRAW
        G.Clear(Color.Wheat)
    End Sub

    Private Sub GetToon(ByVal dir As Short)
        Select Case dir
            Case 1
                If aniFrame = 0 Then
                    sRect = New Rectangle(32, 0, TileSize, TileSize)
                End If
            Case 2
                If aniFrame = 0 Then
                    sRect = New Rectangle(0, 0, TileSize, TileSize)
                End If
            Case 3
                If aniFrame = 0 Then
                    sRect = New Rectangle(0, 32, TileSize, TileSize)
                End If
            Case 4
                If aniFrame = 0 Then
                    sRect = New Rectangle(32, 32, TileSize, TileSize)
                End If
        End Select
    End Sub

    Private Sub TickCounter()
        If tSec = TimeOfDay.Second And IsRunning = True Then
            tTicks = tTicks + 1
        Else
            MaxTicks = tTicks
            tTicks = 0
            tSec = TimeOfDay.Second
        End If
    End Sub

    Private Sub Form1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick
        'MsgBox("You attacked " & mMapX & ":" & mMapY)

        If mouseX = 21 And mouseY = 4 Then
            'PaintBrush = 1
        ElseIf mouseX = 21 And mouseY = 6 Then
            'PaintBrush = 2
        End If

        Select Case PaintBrush
            Case 0

            Case 1 ' Red
                Map(mMapX, mMapY, 0) = 1
            Case 2 ' Blue
                Map(mMapX, mMapY, 0) = 2
        End Select
    End Sub

    Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove

        mouseX = Math.Floor(e.X / TileSize)
        mouseY = Math.Floor(e.Y / TileSize)

        mMapX = MapX + mouseX
        mMapY = MapY + mouseY

    End Sub

    Private Sub GetSourceRect(ByVal X As Integer, ByVal Y As Integer, ByVal w As Integer, ByVal h As Integer)
        Select Case Map(X, Y, 0)
            Case 0 'GRASS
                sRect = New Rectangle(32, 0, TileSize, TileSize)
                Map(X, Y, 1) = 0 'Passable
            Case 1 'Tree
                sRect = New Rectangle(32, 128, TileSize, TileSize)
                Map(X, Y, 1) = 0 'Passable
            Case 2 'Big Tree
                sRect = New Rectangle(0, 64, TileSize, TileSize)
                Map(X, Y, 1) = 0 'Passable
            Case 3 'Weird Mountain
                sRect = New Rectangle(96, 96, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 4 'Mountain Center
                sRect = New Rectangle(160, 128, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 5 'Flowers
                sRect = New Rectangle(64, 0, TileSize, TileSize)
                Map(X, Y, 1) = 0 'Passable
            Case 6 'Water
                sRect = New Rectangle(256, 32, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 7 'Water Top
                sRect = New Rectangle(256, 0, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 8 'Spire
                sRect = New Rectangle(96, 64, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 9 'Bed part 1
                sRect = New Rectangle(224, 96, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 10 'Bed part 2
                sRect = New Rectangle(256, 96, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 11 'Bed part 3
                sRect = New Rectangle(224, 128, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 12 'Bed part 4
                sRect = New Rectangle(256, 128, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 13 'Bed part 5
                sRect = New Rectangle(224, 160, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 14 'Bed part 6
                sRect = New Rectangle(256, 160, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 15 'Black(Not Racist)
                sRect = New Rectangle(288, 96, TileSize, TileSize)
                Map(X, Y, 1) = 1 'Blocked
            Case 16 'Floor
                sRect = New Rectangle(288, 128, TileSize, TileSize)
                Map(X, Y, 1) = 0 '
            Case 17 'Walls
                sRect = New Rectangle(288, 160, TileSize, TileSize)
                Map(X, Y, 1) = 0 'Blocked
        End Select
    End Sub

    Private Sub DrawDialogBox(ByVal text As String)
        Dim brshBG As Brush = New SolidBrush(Color.FromArgb(19, Color.Black))
        Dim bmpDialog As Bitmap = New Bitmap(GFX.pbDialog.Image)
        Dim fntChat As Font = New Font("Verdana", 12)

        sRect = New Rectangle(0, 0, 136, 146)
        dRect = New Rectangle(10, 10, 600, 90)

        bmpDialog.MakeTransparent(Color.Fuchsia)

        G.FillRectangle(brshBG, 25, 13, 600 - 50, 83)
        G.DrawImage(bmpDialog, dRect, sRect, GraphicsUnit.Pixel)
        G.DrawString(text, fntChat, Brushes.White, 40, 20)
    End Sub

    Private Sub DrawInventory()
        Dim brshBG As Brush = New SolidBrush(Color.FromArgb(19, Color.Black))
        Dim bmpDialog As Bitmap = New Bitmap(GFX.pbDialog.Image)
        Dim fntChat As Font = New Font("Verdana", 12)

        sRect = New Rectangle(0, 0, 136, 146)
        dRect = New Rectangle(10, 10, 600, 90)

        bmpDialog.MakeTransparent(Color.Fuchsia)

        G.FillRectangle(brshBG, 25, 13, 600 - 50, 83)
        G.DrawImage(bmpDialog, dRect, sRect, GraphicsUnit.Pixel)
        G.DrawString(text, fntChat, Brushes.White, 40, 20)
    End Sub

    Private Function IsBlocked(ByVal dir As Short) As Boolean
        Select Case dir
            Case 0 ' NORTH
                If Map(GuyX / TileSize, Math.Ceiling(GuyY / TileSize) - 1, 1) = 1 Then
                    Return True
                End If
            Case 1 ' SOUTH
                If Map(GuyX / TileSize, Math.Floor(GuyY / TileSize) + 1, 1) = 1 Then
                    Return True
                End If
            Case 2 ' WEST
                If Map(Math.Ceiling(GuyX / TileSize) - 1, GuyY / TileSize, 1) = 1 Then
                    Return True
                End If
            Case 3 ' EAST
                If Map(Math.Floor(GuyX / TileSize) + 1, GuyY / TileSize, 1) = 1 Then
                    Return True
                End If
        End Select

        Return False
    End Function

    Private Sub LoadMap(ByVal MapFile As String)
        Try
            Dim sr As New IO.StreamReader(MapFile & ".map")
            Dim intValue As String = ""
            Dim strLine As String = ""
            Dim X As Integer = 0
            Dim Y As Integer = 0

            Do Until sr.EndOfStream
                strLine = sr.ReadLine
                strLine = strLine.Replace(strLine.LastIndexOf(","), "")
                For Each item As String In Split(strLine, ",", -1)
                    'MsgBox("X:" & X & " Y:" & Y & "= " & item)
                    If item = "" Then
                        item = 0
                    End If
                    If X <= MapWidth Then
                        Map(X, Y, 0) = Int(item)
                    End If

                    X = X + 1
                Next

                X = 0
                Y = Y + 1
            Loop

            sr.Close()
            sr.Dispose()
        Catch ex As Exception
            MsgBox("Map: " & MapFile & " could not be loaded." & vbCrLf & vbCrLf & ex.Message, MsgBoxStyle.Critical, "ERROR")
            IsRunning = False
        End Try
    End Sub

    Private Sub SaveMap(ByVal MapFile As String)
        Try
            Dim sw As New IO.StreamWriter(MapFile & ".map")
            Dim intValue As String = ""
            Dim strLine As String = ""
            Dim X As Integer = 0
            Dim Y As Integer = 0

            For Y = 0 To MapHeight
                For X = 0 To MapWidth
                    strLine = strLine & Map(X, Y, 0) & ","
                Next

                sw.WriteLine(strLine)
                strLine = ""
            Next

            sw.Close()
            sw.Dispose()

            MsgBox("Map '" & MapFile & "' successfully saved.", MsgBoxStyle.OkOnly, "SUCCESS")
        Catch ex As Exception
            MsgBox("Map: " & MapFile & " could not be written to." & vbCrLf & vbCrLf & ex.Message, MsgBoxStyle.Critical, "ERROR")
            IsRunning = False
        End Try
    End Sub

    Public Sub GetInfo()
        Try
            ' If My.Computer.FileSystem.FileExists(My.Computer.FileSystem.SpecialDirectories.Temp + "\heroica\" + characterNameString + "loc" + ".xml") Then
            '    Kill(My.Computer.FileSystem.SpecialDirectories.Temp + "\heroica\" + characterNameString + "loc" + ".xml")
            'End If
            ' Dim FTPFile As String = characterNameString & "loc" & ".xml"
            Dim FTP As String = "ftp://heroica.freehostingcloud.com/UserLoc/"
            Dim FTPUser As String = "Accounts@heroica.freehostingcloud.com"
            Dim FTPPass As String = "isaacval"
            'Dim XMLLocation As String = My.Computer.FileSystem.SpecialDirectories.Temp + "\heroica\" + characterNameString + "loc" + ".xml"
            'My.Computer.Network.DownloadFile(FTP + FTPFile, XMLLocation, FTPUser, FTPPass)
            ' Dim playerXMLSaveFile As XDocument = XDocument.Load(My.Computer.FileSystem.SpecialDirectories.Temp + "\heroica\" + characterNameString + "loc" + ".xml")
            ' Dim desc = playerXMLSaveFile.Descendants("Info").FirstOrDefault()
            ' DownloadedLocY = desc...<locY>.Value
            ' DownloadedLocX = desc...<locX>.Value
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
        Try
            If My.Computer.FileSystem.FileExists(My.Computer.FileSystem.SpecialDirectories.Temp + "\heroica\" + Login.UsernameTextBox.Text + ".png") Then
                Kill(My.Computer.FileSystem.SpecialDirectories.Temp + "\heroica\" + Login.UsernameTextBox.Text + ".png")
            End If
            Dim FTPUser As String = "Accounts@heroica.freehostingcloud.com"
            Dim FTPPass As String = "isaacval"
            Dim FTP As String = "ftp://heroica.freehostingcloud.com/UserPics/"
            Dim PicFile As String = Login.UsernameTextBox.Text & ".png"
            Dim SavePic As String = My.Computer.FileSystem.SpecialDirectories.Temp & "\heroica\" & PicFile
            My.Computer.Network.DownloadFile(FTP + PicFile, SavePic, FTPUser, FTPPass)
            'playerPictureBox.ImageLocation = My.Computer.FileSystem.SpecialDirectories.Temp & "\heroica\" & PicFile
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
    End Sub
    Private Sub uploadLoc()
        Try
            Dim GuyNegative As Integer = 6
            Dim GuyXNegative As String
            Dim GuyYNegative As String
            'GuyXNegative = GuyX - GuyNegative
            'GuyYNegative = GuyY - GuyNegative
            Dim playerXMLSaveFile = _
                <?xml version="1.0" encoding="utf-8" standalone="yes"?>
                <!--Heroica player save file-->
                <Info>

                    <locX><%= GuyXNegative %></locX>
                    <locY><%= GuyYNegative %></locY>
                </Info>
            'playerXMLSaveFile.Save(My.Computer.FileSystem.SpecialDirectories.Temp & "\heroica\" & characterNameString & "loc" & ".xml")
            'Dim PlayerXML As String = My.Computer.FileSystem.SpecialDirectories.Temp + "\heroica\" + characterNameString & "loc" & ".xml"
            ' Dim FTPFile As String = characterNameString & "loc" & ".xml"
            Dim FTP As String = "ftp://heroica.freehostingcloud.com/UserLoc/"
            Dim FTPUser As String = "Accounts@heroica.freehostingcloud.com"
            Dim FTPPass As String = "isaacval"
            'My.Computer.Network.UploadFile(PlayerXML, FTP & FTPFile, FTPUser, FTPPass)
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
    End Sub
    Private Function Rand(ByVal intStart As Integer, ByVal intEnd As Integer)
        Dim rnd As New Random
        Dim RndNo As Integer = rnd.Next(intStart, intEnd + 1)
        Return RndNo
    End Function
    Private Sub Game_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        Me.Hide()
        Me.ShowInTaskbar = False
        uploadLoc()
        End
    End Sub

    Private Sub animationTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles animationTimer.Tick
        If aniFrame = 0 Then
            aniFrame = 1
        Else
            aniFrame = 0
        End If
    End Sub
End Class
